See https://psyarxiv.com/5ygtc/

Participants

library(tidyverse)
library(easystats)
library(patchwork)
library(lavaan)
library(ggraph)
library(tidySEM)

df <- haven::read_sav("data/Data_Study 1.sav") |> 
  mutate_all(as.numeric) |> 
  filter(!is.na(exclude) & exclude == 0) |> 
  mutate(gen = as.character(ifelse(gen == 1, "Male", ifelse(gen == 2, "Female", "Other"))))

data <- df |> 
  select(matches("npi[[:digit:]]"),
         matches("narq[[:digit:]]"),
         matches("pni[[:digit:]]"),
         matches("hn[[:digit:]]"),
         matches("dt[[:digit:]]"),
         matches("dsm[[:digit:]]")) |> 
  select(-ends_with("r")) |> 
  normalize(verbose=FALSE) |> 
  mutate(across(everything(), as.numeric))


# names(df)
# data
# summary(data)

paste0(
  "Data from the [study 1](https://osf.io/gp6a4/) (Weidmann et al.), downloaded from OSF, included ",
  report::report_participants(df, age = "age", gender = "gen", race = NA),
  "."
)

[1] “Data from the study 1 (Weidmann et al.), downloaded from OSF, included 5736 participants (Mean age = 21.3, SD = 6.9, range: [18, 75], 2.6% missing; Gender: 64.1% women, 32.5% men, 0.40% non-binary, 3.07% missing).”

Distributions

plot_hist <- function(data, x) {
  data |> 
    select(starts_with(x)) |> 
    pivot_longer(everything()) |> 
    filter(!is.na(value)) |> 
    ggplot(aes(x = value)) +
    geom_histogram(aes(fill=name), alpha = 0.3, position = "dodge") +
    theme(legend.position = "none")
}

patchwork::wrap_plots(
  plot_hist(data, "npi"),
  plot_hist(data, "narq"),
  plot_hist(data, "pni"),
  plot_hist(data, "hn"),
  plot_hist(data, "dt"),
  plot_hist(data, "dsm")
)

Distributions

plot_hist <- function(data, x) {
  data |> 
    select(starts_with(x)) |> 
    pivot_longer(everything()) |> 
    filter(!is.na(value)) |> 
    ggplot(aes(x = value)) +
    geom_histogram(aes(fill=name), alpha = 0.3, position = "dodge") +
    theme(legend.position = "none")
}

patchwork::wrap_plots(
  plot_hist(data, "npi"),
  plot_hist(data, "narq"),
  plot_hist(data, "pni"),
  plot_hist(data, "hn"),
  plot_hist(data, "dt"),
  plot_hist(data, "dsm")
)

Correlation

# r <- cor(data, use = "pairwise.complete.obs")
r <- correlation(data) 

r |> 
  arrange(desc(abs(r))) |> 
  head()
## # Correlation Matrix (pearson-method)
## 
## Parameter1 | Parameter2 |    r |       95% CI |     t |   df |         p
## ------------------------------------------------------------------------
## narq6      |      narq9 | 0.70 | [0.69, 0.71] | 67.89 | 4803 | < .001***
## pni8       |      pni16 | 0.70 | [0.68, 0.71] | 61.86 | 4021 | < .001***
## pni8       |      pni40 | 0.65 | [0.63, 0.67] | 53.91 | 4027 | < .001***
## pni30      |      pni36 | 0.65 | [0.63, 0.66] | 53.94 | 4032 | < .001***
## pni31      |      pni45 | 0.65 | [0.63, 0.66] | 53.84 | 4022 | < .001***
## narq11     |      pni29 | 0.64 | [0.62, 0.66] | 50.53 | 3625 | < .001***
## 
## p-value adjustment method: Holm (1979)
## Observations: 3627-4805

EFA

n <- parameters::n_factors(data, n_max = 15)

n
## # Method Agreement Procedure:
## 
## The choice of 1 dimensions is supported by 2 (28.57%) methods out of 7 (Acceleration factor, VSS complexity 1).

plot(n)

efa1 <- parameters::factor_analysis(data, n=1, sort = TRUE)

efa3 <- parameters::factor_analysis(data, n=3, rotation = "oblimin", sort = TRUE)

efa3_varimax <- parameters::factor_analysis(data, n=3, rotation = "varimax", sort = TRUE)

efa3_equamax <- parameters::factor_analysis(data, n=3, rotation = "equamax", sort = TRUE)

efa3_bentlerQ <- parameters::factor_analysis(data, n=3, rotation = "bentlerQ", sort = TRUE)

wrap_plots(plot(efa3), plot(efa3_varimax), plot(efa3_equamax), plot(efa3_bentlerQ))

CFA

cfa1 <-  parameters::efa_to_cfa(efa1, sort=TRUE, max_per_dimension=5) |> 
  lavaan::cfa(data=data)

cfa3 <- parameters::efa_to_cfa(efa3, threshold = "max", sort=TRUE, max_per_dimension=5) |> 
  lavaan::cfa(data=data)

cfa3b <- parameters::efa_to_cfa(efa3_varimax, threshold = "max", sort=TRUE, max_per_dimension=5) |> 
  lavaan::cfa(data=data)

cfa3c <- parameters::efa_to_cfa(efa3_equamax, threshold = "max", sort=TRUE, max_per_dimension=5) |> 
  lavaan::cfa(data=data)

cfa3d <- parameters::efa_to_cfa(efa3_bentlerQ, threshold = "max", sort=TRUE, max_per_dimension=5) |> 
  lavaan::cfa(data=data)

anova(cfa1, cfa3, cfa3b, cfa3c, cfa3d)
## Chi-Squared Difference Test
## 
##       Df   AIC   BIC  Chisq Chisq diff Df diff Pr(>Chisq)    
## cfa1   5 -1420 -1357   86.6                                  
## cfa3  87 -5396 -5202 1015.1        929      82     <2e-16 ***
## cfa3b 87 -6692 -6498 1306.4        291       0               
## cfa3c 87 -5752 -5559 1133.5       -173       0               
## cfa3d 87 -5396 -5202 1015.1       -118       0               
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

parameters::parameters(cfa3b) |> 
  display()
# Loading
Link Coefficient SE 95% CI z p
MR1 =~ pni16 1.00 0.00 (1.00, 1.00) < .001
MR1 =~ pni8 1.00 0.02 (0.96, 1.05) 45.00 < .001
MR1 =~ pni36 0.99 0.02 (0.94, 1.03) 42.33 < .001
MR1 =~ pni30 0.97 0.02 (0.92, 1.01) 42.96 < .001
MR1 =~ pni47 0.84 0.02 (0.79, 0.88) 36.37 < .001
MR3 =~ narq17 1.00 0.00 (1.00, 1.00) < .001
MR3 =~ narq12 0.90 0.03 (0.84, 0.97) 28.04 < .001
MR3 =~ narq13 0.96 0.04 (0.89, 1.03) 26.81 < .001
MR3 =~ hn10 0.74 0.03 (0.67, 0.80) 21.23 < .001
MR3 =~ narq10 1.04 0.04 (0.97, 1.12) 27.94 < .001
MR2 =~ narq1 1.00 0.00 (1.00, 1.00) < .001
MR2 =~ narq15 1.37 0.05 (1.27, 1.48) 26.45 < .001
MR2 =~ narq3 1.28 0.05 (1.18, 1.37) 26.45 < .001
MR2 =~ narq8 1.22 0.05 (1.12, 1.31) 24.85 < .001
MR2 =~ narq16 1.06 0.04 (0.97, 1.15) 24.04 < .001
# Correlation
Link Coefficient SE 95% CI z p
MR1 ~~ MR3 0.02 1.01e-03 (0.01, 0.02) 15.10 < .001
MR1 ~~ MR2 4.52e-03 8.08e-04 (2.93e-03, 6.10e-03) 5.59 < .001
MR3 ~~ MR2 0.01 7.27e-04 (8.84e-03, 0.01) 14.12 < .001

Items

# chrome-extension://efaidnbmnnnibpcajpcglclefindmkaj/http://www.antoniocasella.eu/archipsy/Wright_2010.pdf
# chrome-extension://efaidnbmnnnibpcajpcglclefindmkaj/http://www.persoc.net/persoc/uploads/Toolbox/NARQ_English.pdf
add_labels <- function(x) {
  case_when(x == "pni8" ~ "When people don’t notice me, I start to feel bad about myself.",
            x == "pni16" ~ "When others don’t notice me, I start to feel worthless.",
            x == "pni18" ~ "I typically get very angry when I’m unable to get what I want from others.",
            x == "pni30" ~ "It’s hard to feel good about myself unless I know other people admire me.",
            x == "pni32" ~ "I am preoccupied with thoughts and concerns that most people are not interested in me.",
            x == "pni36" ~ "It’s hard for me to feel good about myself unless I know other people like me.",
            x == "pni40" ~ "I am disappointed when people don’t notice me.",
            x == "pni47" ~ "When others don’t respond to me the way that I would like them to, it is hard for me to still feel ok with myself.",
            x == "narq1" ~ "I am great.",
            x == "narq3" ~ "I show others how special I am.",
            x == "narq7" ~ "Most of the time I am able to draw people’s attention to myself in conversations.",
            x == "narq8" ~ "I deserve to be seen as a great personality.",
            x == "narq9" ~ "I want my rivals to fail.",
            x == "narq10" ~ "I enjoy it when another person is inferior to me.",
            x == "narq12" ~ "I can barely stand it if another person is at the center of events.",
            x == "narq13" ~ "Most people won’t achieve anything.",
            x == "narq14" ~ "Other people are worth nothing.",
            x == "narq15" ~ "Being a very special person gives me a lot of strength.",
            x == "narq16" ~ "I manage to be the center of attention with my outstanding contributions.",
            x == "narq17" ~ "Most people are somehow losers.",
            x == "hn10" ~ "I am secretly 'put out' or annoyed when other people come to me with their troubles, asking me for my time and sympathy.",
            x == "dt4" ~ "I tend to expect special favors from others.",
            # TODO
            TRUE ~ x)
}


parameters(cfa3b, standardize=TRUE, component="loading") |> 
  arrange(To, desc(abs(Coefficient))) |>
  mutate(Dimension = To, Item = From, Label = add_labels(From),
         Dimension = case_when(Dimension == "MR1" ~ "Demonstration", 
                               Dimension == "MR2" ~ "Grandeur", 
                               TRUE ~ "Antagonism")) |> 
  format_table() |> 
  select(Dimension, Item, Label, Coefficient, CI) |> 
  display()
Dimension Item Label Coefficient CI
Demonstration pni16 When others don’t notice me, I start to feel worthless. 0.81 [0.80, 0.83]
Demonstration pni8 When people don’t notice me, I start to feel bad about myself. 0.81 [0.79, 0.83]
Demonstration pni30 It’s hard to feel good about myself unless I know other people admire me. 0.78 [0.76, 0.80]
Demonstration pni36 It’s hard for me to feel good about myself unless I know other people like me. 0.77 [0.75, 0.79]
Demonstration pni47 When others don’t respond to me the way that I would like them to, it is hard for me to still feel ok with myself. 0.68 [0.66, 0.70]
Grandeur narq3 I show others how special I am. 0.73 [0.70, 0.75]
Grandeur narq15 Being a very special person gives me a lot of strength. 0.73 [0.70, 0.75]
Grandeur narq8 I deserve to be seen as a great personality. 0.65 [0.63, 0.68]
Grandeur narq16 I manage to be the center of attention with my outstanding contributions. 0.62 [0.59, 0.65]
Grandeur narq1 I am great. 0.59 [0.56, 0.62]
Antagonism narq17 Most people are somehow losers. 0.70 [0.67, 0.72]
Antagonism narq12 I can barely stand it if another person is at the center of events. 0.67 [0.64, 0.70]
Antagonism narq10 I enjoy it when another person is inferior to me. 0.67 [0.64, 0.70]
Antagonism narq13 Most people won’t achieve anything. 0.63 [0.60, 0.66]
Antagonism hn10 I am secretly ‘put out’ or annoyed when other people come to me with their troubles, asking me for my time and sympathy. 0.48 [0.45, 0.52]